home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / modula / frctl.mod < prev    next >
Text File  |  1985-11-19  |  3KB  |  93 lines
  1. IMPLEMENTATION MODULE Fractal;
  2.  
  3. (* Atari 520 ST demo module : Draws fractal tree.      *)
  4. (* (c) TDI Software Ltd. 1985 *)
  5.  
  6. (*$T-*)(*$S-*)
  7.  
  8. FROM GEMVDIbase IMPORT
  9.      (* types *) VDIWorkInType, VDIWorkOutType ;
  10.  
  11. FROM VDIControls IMPORT
  12.      (* procs *) OpenVirtualWorkstation, CloseVirtualWorkstation ;
  13.  
  14. FROM VDIOutputs IMPORT
  15.      (* procs *) PolyLine;
  16.  
  17. FROM AESGraphics IMPORT
  18.      (* procs *) GrafHandle;
  19.  
  20. FROM GemDem IMPORT
  21.      (* Vars  *) WorkX, WorkY, WorkWidth, WorkHeight ;
  22.  
  23. CONST xScaler = 1.0;
  24.       yScaler = 1.0;
  25.  
  26. VAR (* these are used inside 'split' *)
  27.     xMax           : REAL ;
  28.     yMax           : REAL ;
  29.     dx,dy, 
  30.     cosphi, sinphi : REAL;
  31.     tab            : ARRAY [0..20] OF REAL;
  32.     Points         : ARRAY [0..3] OF INTEGER;
  33.  
  34.  
  35. PROCEDURE split ( sx, sy, ex, ey : REAL; level : CARDINAL );
  36.  
  37. VAR midx, midy, oldlen, newlen, costheta, sintheta : REAL;
  38.  
  39. BEGIN
  40.   midx := (sx + ex) / 2.0;
  41.   midy := (sy + ey) / 2.0;
  42.   dx := ex - sx;
  43.   dy := ey - sy;
  44.   oldlen := tab [level-1] * 150.0 ;
  45.   newlen := tab [level] * 150.0;
  46.   costheta := dx / oldlen;
  47.   sintheta := dy / oldlen;
  48.   (* draw a line from sx,sy to midx,midy *)
  49.   Points [0] := TRUNC (sx);
  50.   Points [1] := TRUNC (yMax - sy);
  51.   Points [2] := TRUNC (midx);
  52.   Points [3] := TRUNC (yMax - midy);
  53.   PolyLine (handle, 2, Points);
  54.   IF level < maxlevel THEN
  55.     split (midx, midy, newlen*(costheta*cosphi-sintheta*sinphi)+midx,
  56.                        newlen*(sintheta*cosphi+costheta*sinphi)+midy, level+1);
  57.     split (midx, midy, newlen*(costheta*cosphi+sintheta*sinphi)+midx,
  58.                        newlen*(sintheta*cosphi-costheta*sinphi)+midy, level+1);
  59.   END; (* IF *)
  60. END split;
  61.  
  62.  
  63. CONST SplitAngle      = 20.0; (* these give a pretty one *)
  64.       SplitProportion = 0.22; (* discovered by Jon Gray. *)
  65.       maxlevel        = 13;
  66.  
  67. VAR i      : CARDINAL;
  68.     j      : INTEGER;
  69.     In     : VDIWorkInType;
  70.     Out    : VDIWorkOutType;
  71.     handle : INTEGER;
  72.  
  73. PROCEDURE DoFractal ;
  74.  VAR mx, my : REAL ;
  75. BEGIN
  76.   xMax := FLOAT(CARDINAL(WorkX+WorkWidth)) ;
  77.   yMax := FLOAT(CARDINAL(WorkY+WorkHeight)) ;
  78.   handle := GrafHandle (j, j, j, j);
  79.   FOR i := 0 TO 9 DO In [i] := 1 END;
  80.   In [10] := 2; (* use raster coordinates *)
  81.   OpenVirtualWorkstation (In, handle, Out);
  82.   tab[0] := 3.0;
  83.   cosphi := (* cos (SplitAngle) *) 0.93969262;
  84.   sinphi := (* sin (SplitAngle) *) 0.342020143;
  85.   FOR i := 1 TO HIGH(tab) DO tab[i] := SplitProportion * tab[0] END;
  86.   mx := FLOAT(CARDINAL(WorkX+(WorkWidth DIV 2))) ; (* Mid x point *)
  87.   my := FLOAT(CARDINAL(WorkY+(WorkHeight DIV 2)-50)) ; (* mid Y point *)
  88.   split (mx, 0.0,mx, my, 1);
  89.   CloseVirtualWorkstation (handle);
  90. END DoFractal
  91.  
  92. END Fractal.
  93. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə